home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / reader21.arc / R21.PAS next >
Pascal/Delphi Source File  |  1986-06-11  |  13KB  |  363 lines
  1. program reader_21;
  2. {Herein resides the source code and various comments for READER.COM.
  3.  READER 2.1 is used to view PC Gazette issue 1.03 and later.
  4.  Code written by Robert Flores...PC Gazette, 155 East C St. Suite D,
  5.                                     Upland, CA 91786}
  6.  
  7.  
  8. type
  9.     strtype    = string[15];
  10.     viewscreen = array[1..4096] of byte;
  11.     graftype   = array[1..16384] of byte;
  12.     filelabel  = string[12];
  13.     str80      = string[80];
  14.     yesansi    = boolean;
  15.  
  16. var
  17.    i,j,x,y,
  18.    curpage,
  19.    lastpage,
  20.    curpart,
  21.    lastpart,
  22.    maxparts,
  23.    code,
  24.    slidepages,
  25.    i1,j1,i2,j2   : integer;
  26.    file2         : text;
  27.    filename2     : strtype;
  28.    filename,
  29.    grafile2,
  30.    ansifile,
  31.    bwansifile    : array[1..6] of filelabel;
  32.    grafile       : array[0..6] of filelabel;
  33.    ansipage,
  34.    grafpage,
  35.    grafpage2,
  36.    maxpages      : array[1..6] of integer;
  37.    slide         : array[1..13] of filelabel;
  38.    yesani        : array[0..9] of boolean;
  39.    pluscolor,
  40.    ok,mono       : boolean;
  41.    fileline      : strtype;
  42.    ansimove      : str80;
  43.    crtmode       : byte  absolute $0040:$0049;
  44.    scrncolor     : array[0..9] of viewscreen;
  45.    file1         : file;
  46.    getchar       : char;
  47.    storescreen   : graftype;
  48.    screen0       : viewscreen absolute $b800:-7;
  49.    screen1       : viewscreen absolute $b000:-7;
  50.    grafscreen    : graftype absolute $b800:-7;
  51.  
  52.   procedure getparm;  {Find out if there is any parameters on the command line}
  53.     var parms: strtype absolute cseg:$80;
  54.         s:strtype;
  55.     begin
  56.       s:='';
  57.       while (length(parms)>0) and (parms[1]=' ') do delete(parms,1,1);
  58.       while (length(parms)>0) and (parms[1]<>' ') do begin
  59.             s:=s+parms[1];delete(parms,1,1);
  60.       end;
  61.       filename2:=s;
  62.     end;
  63.  
  64.  
  65. procedure showansi(aifile:filelabel);  {Put ANSI animation on screen}
  66.    type  regpack=record
  67.          case integer of
  68.          1 : (AX,BX,CX,DX,BP,SI,DI,DS,ES,FLAGS : INTEGER);
  69.          2 : (AL,AH,BL,BH,CL,CH,DL,DH          : BYTE);
  70.          end;
  71.    var  regs : regpack;
  72.         afile : text;
  73.    begin
  74.         assign(afile,aifile);
  75.         {$i-} reset(afile) {$i+};
  76.         ok:=(ioresult=0);
  77.         if ok  then begin
  78.            readln(afile,ansimove);
  79.            val(copy(ansimove,6,4),i1,code);
  80.            for i:=1 to i1 do begin
  81.                readln(afile,ansimove);
  82.                for j:=1 to length(ansimove) do begin
  83.                   with regs do begin
  84.                       AH:=$02;
  85.                       DL:=ord(copy(ansimove,j,1));
  86.                       msdos(regs);
  87.                    end;
  88.                end;
  89.           end;
  90.           close(afile);
  91.        end;
  92.    end;
  93.  
  94. procedure bottomline;    {Put standard blurb on bottomline}
  95.    begin
  96.         if mono=true then gotoxy(12,25)
  97.         else begin
  98.                if (grafpage[curpart]=curpage) or (grafpage2[curpart]=curpage) then
  99.                 begin
  100.                  gotoxy(42,24);
  101.                  textcolor(white);
  102.                  write(' Press Space Bar for Hi-Res Display ');
  103.                 end;
  104.                gotoxy(6,25);
  105.         end;
  106.         if pluscolor then textcolor(red) else textcolor(15);
  107.         write('Quit:F1   Pages:PgUp,PgDn,Home,End,& 0..',maxpages[curpart],'.  Sections:A..',chr(maxparts+64),'.');
  108.         if mono=false then write('  Gallery:G.');
  109.         if (ansipage[curpart]=curpage) and (yesani[curpage]=false) then
  110.           begin
  111.               if pluscolor then showansi(ansifile[curpart]) else showansi(bwansifile[curpart]);
  112.               yesani[curpage]:=true;
  113.               if mono=true then scrncolor[curpage]:=screen1 else scrncolor[curpage]:=screen0;
  114.           end;
  115.     end;
  116.  
  117.  
  118. procedure LoadScreen(gfile : filelabel);    {Display a hires screen}
  119.           begin
  120.                hires;
  121.                Assign(File1,gfile);
  122.                {$I-} Reset(File1)  {$I+};
  123.                ok:=(IOresult=0);
  124.                if ok then begin
  125.                   blockread(File1,storescreen,128);
  126.                   close (File1);
  127.                   move(storescreen,grafscreen,16384);
  128.                end;
  129.                gotoxy(28,25);
  130.                write('Press any key to continue.');
  131.                gotoxy(1,1);
  132.                read(kbd,getchar);
  133.                textmode(c80);
  134.                if mono=true then screen1:=scrncolor[curpage] else screen0:=scrncolor[curpage];
  135.                bottomline;
  136.           end;
  137.  
  138. procedure Gallery;                   {Display all hires screens}
  139.           label  quitslide1,quitslide2;
  140.           begin
  141.                i:=1;
  142.                hires;
  143.                gotoxy(1,3);
  144.                writeln('                            PC Gazette Gallery');
  145.                gotoxy(1,15);
  146.                writeln('                A collection of PC Graphics for your enjoyment.');
  147.                repeat
  148.                      Assign(file1,slide[i]);
  149.                      {$i-} Reset(file1) {$i+};
  150.                      ok:=(ioresult=0);
  151.                      if not ok then begin
  152.                         writeln(#7,#7,slide[i],' not found!  Press a key to return to PC Gazette.');
  153.                         read(kbd,getchar);
  154.                         goto quitslide1;
  155.                      end
  156.                      else begin
  157.                         blockread(file1,storescreen,128);
  158.                         close(file1);
  159.                         gotoxy(19,25);
  160.                         write('Press any key to continue...Esc to exit.');
  161.                         read(kbd,getchar);
  162.                         if getchar=#27 then goto quitslide2;
  163.                         move(storescreen,grafscreen,16384);
  164.                     end;
  165.                     i:=i+1;
  166.               until i>slidepages;
  167.               quitslide1 : gotoxy(19,25);
  168.               write('Press any key to continue...Esc to exit.');
  169.               read(kbd,getchar);
  170.               quitslide2 : delay(2);
  171.               textmode(c80);
  172.               if mono=true then screen1:=scrncolor[curpage] else screen0:=scrncolor[curpage];
  173.               bottomline;
  174.           end;
  175.  
  176. procedure getpart;     {Load into memory a section of pages}
  177.    begin
  178.         for i:=0 to 9 do yesani[i]:=false;
  179.         assign(file1,filename[curpart]);
  180.         {$i-} reset(file1) {$I+};
  181.         ok:=(ioresult=0);
  182.         if not ok then begin
  183.              writeln(filename[curpart],' not found.');
  184.              halt;
  185.          end;
  186.          clrscr;
  187.          gotoxy(1,5);
  188.          write('Setting up Section ',chr(curpart+64),' into memory');
  189.          gotoxy(1,25);
  190.           for j:=0 to maxpages[curpart] do begin
  191.                  blockread(file1,scrncolor[j],32);
  192.  
  193.            end;
  194.            close(file1);
  195.            if not pluscolor then begin {put color stripping here}
  196.                  for j:=0 to maxpages[curpart] do begin
  197.                            i:=seg(scrncolor[j]);i2:=ofs(scrncolor[j]);i2:=i2+8;j2:=0;
  198.                            repeat
  199.                                  mem[i:i2+j2]:=112;j2:=j2+2;
  200.                            until j2>3840;
  201.                  end;
  202.            end;
  203.            if crtmode=7 then screen1:=scrncolor[0] else screen0:=scrncolor[0];
  204.  
  205.            curpage:=0;lastpage:=0;
  206.            bottomline;
  207.            if (mono=false) and (grafpage[curpart]=curpage) then loadscreen(grafile[curpart]);
  208.            if (mono=false) and (grafpage2[curpart]=curpage) then loadscreen(grafile2[curpart]);
  209.    end;
  210.  
  211.  
  212. procedure startoff;              {Find out what files will be used}
  213.    var ifile : filelabel;
  214.    begin
  215.  
  216.         curpage:=0;lastpage:=0;curpart:=1;lastpart:=1;slidepages:=0;ifile:='reader.opt';
  217.         getparm;
  218.         if length(filename2)>0 then ifile:='reader.'+copy(filename2,1,3) else ifile:='reader.opt';
  219. {        writeln(ifile);
  220.         read(kbd,getchar);}
  221.         assign(file2,ifile);
  222.         {$i-} reset(file2) {$i+};
  223.         ok:=(ioresult=0);
  224.         if not ok then begin writeln(ifile,' not found.');halt end
  225.         else begin
  226.            readln(file2,maxparts);
  227.            readln(file2,grafile[0]);
  228.            if (grafile[0]<>'<none>') and (mono=false) then loadscreen(grafile[0]);
  229.            for i:=1 to maxparts do begin
  230.              readln(file2,filename[i]);
  231.              readln(file2,maxpages[i]);
  232.              readln(file2,grafile[i]);
  233.              readln(file2,grafpage[i]);
  234.              readln(file2,grafile2[i]);
  235.              readln(file2,grafpage2[i]);
  236.              readln(file2,ansifile[i]);
  237.              readln(file2,bwansifile[i]);
  238.              readln(file2,ansipage[i]);
  239.           end;
  240.           readln(file2,slidepages);
  241.           if slidepages>0 then for i:=1 to slidepages do readln(file2,slide[i]);
  242.         end;
  243.         close(file2);
  244.  
  245.    end;
  246.  
  247. Function getkey(var functionkey : boolean):char;     {check keypress & see if it is a function key}
  248.    var ch : char;
  249.    begin
  250.         read(kbd,ch);
  251.         if (ch=#27) and keypressed then begin
  252.            read(kbd,ch);
  253.            functionkey:=true;
  254.         end
  255.         else functionkey:=false;
  256.         getkey:=ch;
  257.    end;
  258.  
  259. procedure movepage;  {Determine what do do with keypress and execute}
  260.    var
  261.       inkey:char;
  262.       functionkey:boolean;
  263.    procedure pagemove(inkey:char; functionkey:boolean);
  264.  
  265.       procedure dofunctioncommand(functkey:char);
  266.          begin
  267.               case functkey of
  268.               #71  : curpage:=0;
  269.               #79  : curpage:=maxpages[curpart];
  270.               #73  : curpage:=curpage-1;
  271.               #81  : curpage:=curpage+1;
  272.               #59  : begin
  273.                        clrscr;
  274.                        halt;
  275.                      end;
  276.                end;
  277.          end;
  278.       begin
  279.            if functionkey then dofunctioncommand(inkey)
  280.            else
  281.            case upcase(inkey) of
  282.            '0'..'9': val(inkey,curpage,code);
  283.            'A'..'F': begin
  284.                        case upcase(inkey) of
  285.                        'A' : curpart:=1;
  286.                        'B' : if maxparts>1 then curpart:=2;
  287.                        'C' : if maxparts>2 then curpart:=3;
  288.                        'D' : if maxparts>3 then curpart:=4;
  289.                        'E' : if maxparts>4 then curpart:=5;
  290.                        'F' : if maxparts>5 then curpart:=6;
  291.                        end;
  292.                        getpart;
  293.                      end;
  294.            'G'     : if (mono=false) and (slidepages>0) then gallery;
  295.            #32     : begin
  296.                         if (mono=false) and (grafpage[curpart]=curpage) then loadscreen(grafile[curpart]);
  297.                         if (mono=false) and (grafpage2[curpart]=curpage) then loadscreen(grafile2[curpart]);
  298.                      end;
  299.            end;
  300.       end;
  301.       procedure increment;
  302.          begin
  303.               if curpage>maxpages[curpart] then curpage:=maxpages[curpart];
  304.               if curpage<0 then curpage:=0;
  305.               if curpage<>lastpage then begin
  306.                   if crtmode=7 then screen1:=scrncolor[curpage] else screen0:=scrncolor[curpage];
  307.                   bottomline;
  308.                end;
  309.               lastpage:=curpage;
  310.          end;
  311.    begin
  312.         repeat
  313.               inkey:=getkey(functionkey);
  314.               pagemove(inkey,functionkey);
  315.               increment;
  316.         until upcase(inkey) in [#10,^C,#59];
  317.    end;
  318.  
  319. begin
  320.      for j:=0 to 9 do yesani[j]:=false;
  321.      if crtmode=7 then mono:=true else mono:=false;   {mono or color card?}
  322.      clrscr;
  323.      if mono=true then scrncolor[0]:=screen1 else scrncolor[0]:=screen0; {put page at right address}
  324.      yesani[0]:=true;
  325.      startoff;
  326.      clrscr;
  327.  
  328.      textcolor(15);
  329.      textbackground(black);
  330. writeln('                Aaron A. Aardvark and the Platypus Patrol present');
  331. writeln;
  332. writeln('═══════════════════════════════════════════════════════════════════════════════');
  333. writeln('   ░░░░░▄░░░░░▄    ░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄░░░░░▄');
  334. writeln('   ░░░█░█░░░█▀▀    ░░░█▀▀░░░█░█ ▀░░░█░░░█▀▀ ░░░█▀ ░░░█▀░░░█▀▀        The');
  335. writeln('   ░░░█░█░░░█      ░░░█░▄░░░█░█ ░░░█▀░░░░░▄ ░░░█  ░░░█ ░░░░░▄     Electronic');
  336. writeln('   ░░░░░█░░░█      ░░░█░█░░░░░█░░░█▀ ░░░█▀▀ ░░░█  ░░░█ ░░░█▀▀      Journal');
  337. writeln('   ░░░█▀▀░░░░░▄    ░░░░░█░░░█░█░░░░░▄░░░░░▄ ░░░█  ░░░█ ░░░░░▄');
  338. writeln('    ▀▀▀   ▀▀▀▀▀     ▀▀▀▀▀ ▀▀▀ ▀ ▀▀▀▀▀ ▀▀▀▀▀  ▀▀▀   ▀▀▀  ▀▀▀▀▀');
  339. writeln('═══════════════════════════════════════════════════════════════════════════════');
  340. WRITELN;
  341. writeln('                            created by Robert Flores');
  342. writeln('                    Copyright 1986 Robert Flores` PC Gazette');
  343. writeln;
  344. writeln('                          A User-supported Newsletter');
  345. writeln;
  346. writeln('                               Reader version 2.1');
  347. gotoxy(1,25);
  348.  
  349.      if mono=true then begin
  350.         pluscolor:=false;
  351.         write('                              Press any key to begin.');
  352.         read(kbd,getchar);
  353.      end
  354.      else begin
  355.           write('                        Do you want this in color? (Y/N)');
  356.           read(kbd,getchar);
  357.           if upcase(getchar)='Y' then pluscolor:=true else pluscolor:=false;
  358.      end;
  359.      CLRSCR;
  360.      getpart;
  361.      movepage;
  362. end.               {That's all, folks!! R.F}
  363.